Descarga de datos

library(tidyquant)
library(tidyverse)
library(tsibble)
library(fable)
library(feasts)
data = tq_get("^GSPC", get="stock.prices", from = "2022-01-01", to = "2024-03-28") %>% select(date, adjusted) %>% as_tsibble(index = date)
data

Row Number

data_row_number <- data |>
  mutate(t = row_number()) |>
  update_tsibble(index = t, regular = TRUE) %>% select(t, adjusted)

data_row_number
data_row_number |>
  model(
    STL(adjusted ~ season(period = 5) + season(period = 20) + season(period = 252),
        robust = TRUE)
  ) |>
  components() |>
  autoplot() + labs(x = "Observation")

my_dcmp_spec <- decomposition_model(
  STL(adjusted ~ season(period = 5),
      robust = TRUE),
  ETS(season_adjust)
)
fc <- data_row_number |>
  model(my_dcmp_spec) |>
  forecast(h = 25)
plot = fc |>
  fill_gaps() |>
  autoplot(data_row_number) +
  labs(y = "SP500",
       title = "SP500")

plot

fit3 <- data_row_number %>% 
  model(
    harmonic = ARIMA(adjusted ~ trend() + fourier(period = 5, K = 2) + fourier(period = 25, K = 4) + fourier(period = 252, K = 10))
  )
fc <- fit3 %>%
  forecast(h = 25)

fc |>
  fill_gaps() |>
  autoplot(data_row_number) +
  labs(y = "SP500",
       title = "SP500")

Fill na

data
data_fill_na = fill_gaps(data) %>% fill(adjusted, .direction = "down")
data_fill_na
comp_stl <- data_fill_na %>% 
  model(
    STL(adjusted, robust = TRUE)
  ) %>% 
  components() 

comp_stl %>% 
  autoplot()

comp_stl %>% 
  autoplot(season_year)

comp_stl %>% 
  autoplot(season_week)

comp_stl %>% 
  ggplot(aes(x = date, y = season_adjust)) +
  geom_line()

my_dcmp_spec <- decomposition_model(
  STL(adjusted ~ season(period = 5),
      robust = TRUE),
  ETS(season_adjust)
)
fc <- data_fill_na |>
  model(my_dcmp_spec) |>
  forecast(h = 20)
plot = fc |>
  fill_gaps() |>
  autoplot(data_fill_na) +
  labs(y = "SP500",
       title = "SP500")

plot

fit3 <- data_fill_na %>% 
  model(
    harmonic = ARIMA(adjusted ~ trend() + fourier(period = 5, K = 2) + fourier(period = 252, K = 20))
  )
Warning: NaNs produced
fc <- fit3 %>%
  forecast(h = 25)

fc |>
  fill_gaps() |>
  autoplot(data_fill_na) +
  labs(y = "SP500",
       title = "SP500")

fit3 <- data_fill_na %>% 
  model(
    harmonic = ARIMA(adjusted ~ trend() + fourier(period = "week", K = 2) +
          fourier(period = "year", K = 3))

  )
fc <- fit3 %>%
  forecast(h = 25)

fc |>
  fill_gaps() |>
  autoplot(data_fill_na) +
  labs(y = "SP500",
       title = "SP500")

Prophet

library(fable.prophet)
colnames(data) = c("ds", "y")
fit_prophet = data %>% model(prophet = prophet(y))
fc <- fit_prophet %>% forecast(h = 25)
fc %>% autoplot(data)

fit_prophet |>
  components() |>
  autoplot()

components(fit_prophet)
fit_prophet = data %>% model(prophet(y ~ season(type = "additive")))
fc <- fit_prophet %>% forecast(h = 25)
fc %>% autoplot(data)

fit_prophet |>
  components() |>
  autoplot()

fit_prophet = data %>% model(prophet(y ~ season(period = "day", order = 5) +
                                        season(period = "week", order = 2) +
                                        season(period = "year", order = 2)))
fc <- fit_prophet %>% forecast(h = 25)
fc %>% autoplot(data)

fit_prophet |>
  components() |>
  autoplot()
?prophet
index = tq_index("SP500") %>% select(symbol, weight)
Getting holdings for SP500
index = index %>% filter(symbol != "-")
index
sum(index$weight)
[1] 0.9962656
data = tq_get(index$symbol, get = "stock.prices", from = "2024-01-01", to = "2024-03-29") %>% select(symbol, date, adjusted)
LS0tCnRpdGxlOiAnUyZQIDUwMCcKc3VidGl0bGU6ICdDbGFzZSBzZXJpZXMgZGUgdGllbXBvLCBwcmltYXZlcmEgMjAyNCcKYXV0aG9yOiAnRGFuaWVsIE51w7FvLCBkYW5pZWwubnVub0BpdGVzby5teCcKZGF0ZTogIkFicmlsIDEwLCAyMDI0IgpvdXRwdXQ6CiAgaHRtbF9ub3RlYm9vazoKICAgIHRvYzogeWVzCiAgICB0b2NfZmxvYXQ6IHllcwogICAgdGhlbWU6IGNvc21vCiAgICBoaWdobGlnaHQ6IHRhbmdvCiAgZ2l0aHViX2RvY3VtZW50OgogICAgdG9jOiB5ZXMKICAgIGRldjoganBlZwogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IHllcwogICAgZGZfcHJpbnQ6IHBhZ2VkCi0tLQoKYGBge3Igc2V0dXAsIGVjaG8gPSBGQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG89IFRSVUUsCiAgICAgICAgICAgICAgICAgICAgICBmaWcuaGVpZ2h0ID0gNiwgZmlnLndpZHRoID0gNykKYGBgCgpgYGB7PWh0bWx9CjxzdHlsZT4KLmZvcmNlQnJlYWsgeyAtd2Via2l0LWNvbHVtbi1icmVhay1hZnRlcjogYWx3YXlzOyBicmVhay1hZnRlcjogY29sdW1uOyB9Cjwvc3R5bGU+CmBgYAo8Y2VudGVyPiFbXShodHRwczovL3VwbG9hZC53aWtpbWVkaWEub3JnL3dpa2lwZWRpYS9jb21tb25zL2QvZGIvTG9nb19JVEVTT19ub3JtYWwuanBnKXt3aWR0aD0iMjAlIn08L2NlbnRlcj4KCiMgRGVzY2FyZ2EgZGUgZGF0b3MKCmBgYHtyfQpsaWJyYXJ5KHRpZHlxdWFudCkKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkodHNpYmJsZSkKbGlicmFyeShmYWJsZSkKbGlicmFyeShmZWFzdHMpCmRhdGEgPSB0cV9nZXQoIl5HU1BDIiwgZ2V0PSJzdG9jay5wcmljZXMiLCBmcm9tID0gIjIwMjItMDEtMDEiLCB0byA9ICIyMDI0LTAzLTI4IikgJT4lIHNlbGVjdChkYXRlLCBhZGp1c3RlZCkgJT4lIGFzX3RzaWJibGUoaW5kZXggPSBkYXRlKQpgYGAKCmBgYHtyfQpkYXRhCmBgYAoKIyBSb3cgTnVtYmVyCgpgYGB7cn0KZGF0YV9yb3dfbnVtYmVyIDwtIGRhdGEgfD4KICBtdXRhdGUodCA9IHJvd19udW1iZXIoKSkgfD4KICB1cGRhdGVfdHNpYmJsZShpbmRleCA9IHQsIHJlZ3VsYXIgPSBUUlVFKSAlPiUgc2VsZWN0KHQsIGFkanVzdGVkKQoKZGF0YV9yb3dfbnVtYmVyCmBgYAoKYGBge3J9CmRhdGFfcm93X251bWJlciB8PgogIG1vZGVsKAogICAgU1RMKGFkanVzdGVkIH4gc2Vhc29uKHBlcmlvZCA9IDUpICsgc2Vhc29uKHBlcmlvZCA9IDIwKSArIHNlYXNvbihwZXJpb2QgPSAyNTIpLAogICAgICAgIHJvYnVzdCA9IFRSVUUpCiAgKSB8PgogIGNvbXBvbmVudHMoKSB8PgogIGF1dG9wbG90KCkgKyBsYWJzKHggPSAiT2JzZXJ2YXRpb24iKQpgYGAKCmBgYHtyfQpteV9kY21wX3NwZWMgPC0gZGVjb21wb3NpdGlvbl9tb2RlbCgKICBTVEwoYWRqdXN0ZWQgfiBzZWFzb24ocGVyaW9kID0gNSksCiAgICAgIHJvYnVzdCA9IFRSVUUpLAogIEVUUyhzZWFzb25fYWRqdXN0KQopCmZjIDwtIGRhdGFfcm93X251bWJlciB8PgogIG1vZGVsKG15X2RjbXBfc3BlYykgfD4KICBmb3JlY2FzdChoID0gMjUpCmBgYAoKYGBge3J9CnBsb3QgPSBmYyB8PgogIGZpbGxfZ2FwcygpIHw+CiAgYXV0b3Bsb3QoZGF0YV9yb3dfbnVtYmVyKSArCiAgbGFicyh5ID0gIlNQNTAwIiwKICAgICAgIHRpdGxlID0gIlNQNTAwIikKCnBsb3QKYGBgCgpgYGB7cn0KZml0MyA8LSBkYXRhX3Jvd19udW1iZXIgJT4lIAogIG1vZGVsKAogICAgaGFybW9uaWMgPSBBUklNQShhZGp1c3RlZCB+IHRyZW5kKCkgKyBmb3VyaWVyKHBlcmlvZCA9IDUsIEsgPSAyKSArIGZvdXJpZXIocGVyaW9kID0gMjUsIEsgPSA0KSArIGZvdXJpZXIocGVyaW9kID0gMjUyLCBLID0gMTApKQogICkKCmBgYAoKYGBge3J9CmZjIDwtIGZpdDMgJT4lCiAgZm9yZWNhc3QoaCA9IDI1KQoKZmMgfD4KICBmaWxsX2dhcHMoKSB8PgogIGF1dG9wbG90KGRhdGFfcm93X251bWJlcikgKwogIGxhYnMoeSA9ICJTUDUwMCIsCiAgICAgICB0aXRsZSA9ICJTUDUwMCIpCmBgYAoKIyBGaWxsIG5hCgpgYGB7cn0KZGF0YQpgYGAKCgpgYGB7cn0KZGF0YV9maWxsX25hID0gZmlsbF9nYXBzKGRhdGEpICU+JSBmaWxsKGFkanVzdGVkLCAuZGlyZWN0aW9uID0gImRvd24iKQpkYXRhX2ZpbGxfbmEKYGBgCgpgYGB7cn0KY29tcF9zdGwgPC0gZGF0YV9maWxsX25hICU+JSAKICBtb2RlbCgKICAgIFNUTChhZGp1c3RlZCwgcm9idXN0ID0gVFJVRSkKICApICU+JSAKICBjb21wb25lbnRzKCkgCgpjb21wX3N0bCAlPiUgCiAgYXV0b3Bsb3QoKQpgYGAKCmBgYHtyfQpjb21wX3N0bCAlPiUgCiAgYXV0b3Bsb3Qoc2Vhc29uX3llYXIpCmNvbXBfc3RsICU+JSAKICBhdXRvcGxvdChzZWFzb25fd2VlaykKY29tcF9zdGwgJT4lIAogIGdncGxvdChhZXMoeCA9IGRhdGUsIHkgPSBzZWFzb25fYWRqdXN0KSkgKwogIGdlb21fbGluZSgpCmBgYAoKYGBge3J9Cm15X2RjbXBfc3BlYyA8LSBkZWNvbXBvc2l0aW9uX21vZGVsKAogIFNUTChhZGp1c3RlZCB+IHNlYXNvbihwZXJpb2QgPSA1KSwKICAgICAgcm9idXN0ID0gVFJVRSksCiAgRVRTKHNlYXNvbl9hZGp1c3QpCikKZmMgPC0gZGF0YV9maWxsX25hIHw+CiAgbW9kZWwobXlfZGNtcF9zcGVjKSB8PgogIGZvcmVjYXN0KGggPSAyMCkKYGBgCgpgYGB7cn0KcGxvdCA9IGZjIHw+CiAgZmlsbF9nYXBzKCkgfD4KICBhdXRvcGxvdChkYXRhX2ZpbGxfbmEpICsKICBsYWJzKHkgPSAiU1A1MDAiLAogICAgICAgdGl0bGUgPSAiU1A1MDAiKQoKcGxvdApgYGAKCmBgYHtyfQpmaXQzIDwtIGRhdGFfZmlsbF9uYSAlPiUgCiAgbW9kZWwoCiAgICBoYXJtb25pYyA9IEFSSU1BKGFkanVzdGVkIH4gdHJlbmQoKSArIGZvdXJpZXIocGVyaW9kID0gNSwgSyA9IDIpICsgZm91cmllcihwZXJpb2QgPSAyNTIsIEsgPSAyMCkpCiAgKQoKYGBgCgpgYGB7cn0KZmMgPC0gZml0MyAlPiUKICBmb3JlY2FzdChoID0gMjUpCgpmYyB8PgogIGZpbGxfZ2FwcygpIHw+CiAgYXV0b3Bsb3QoZGF0YV9maWxsX25hKSArCiAgbGFicyh5ID0gIlNQNTAwIiwKICAgICAgIHRpdGxlID0gIlNQNTAwIikKYGBgCgpgYGB7cn0KZml0MyA8LSBkYXRhX2ZpbGxfbmEgJT4lIAogIG1vZGVsKAogICAgaGFybW9uaWMgPSBBUklNQShhZGp1c3RlZCB+IHRyZW5kKCkgKyBmb3VyaWVyKHBlcmlvZCA9ICJ3ZWVrIiwgSyA9IDIpICsKICAgICAgICAgIGZvdXJpZXIocGVyaW9kID0gInllYXIiLCBLID0gMykpCgogICkKCmBgYAoKYGBge3J9CmZjIDwtIGZpdDMgJT4lCiAgZm9yZWNhc3QoaCA9IDI1KQoKZmMgfD4KICBmaWxsX2dhcHMoKSB8PgogIGF1dG9wbG90KGRhdGFfZmlsbF9uYSkgKwogIGxhYnMoeSA9ICJTUDUwMCIsCiAgICAgICB0aXRsZSA9ICJTUDUwMCIpCmBgYAoKCiMgUHJvcGhldAoKYGBge3J9CmxpYnJhcnkoZmFibGUucHJvcGhldCkKY29sbmFtZXMoZGF0YSkgPSBjKCJkcyIsICJ5IikKYGBgCgpgYGB7cn0KZml0X3Byb3BoZXQgPSBkYXRhICU+JSBtb2RlbChwcm9waGV0ID0gcHJvcGhldCh5KSkKYGBgCgpgYGB7cn0KZmMgPC0gZml0X3Byb3BoZXQgJT4lIGZvcmVjYXN0KGggPSAyNSkKZmMgJT4lIGF1dG9wbG90KGRhdGEpCmBgYAoKYGBge3J9CmZpdF9wcm9waGV0IHw+CiAgY29tcG9uZW50cygpIHw+CiAgYXV0b3Bsb3QoKQpgYGAKCmBgYHtyfQpjb21wb25lbnRzKGZpdF9wcm9waGV0KQpgYGAKCmBgYHtyfQpmaXRfcHJvcGhldCA9IGRhdGEgJT4lIG1vZGVsKHByb3BoZXQoeSB+IHNlYXNvbih0eXBlID0gImFkZGl0aXZlIikpKQpgYGAKCmBgYHtyfQpmYyA8LSBmaXRfcHJvcGhldCAlPiUgZm9yZWNhc3QoaCA9IDI1KQpmYyAlPiUgYXV0b3Bsb3QoZGF0YSkKYGBgCgpgYGB7cn0KZml0X3Byb3BoZXQgfD4KICBjb21wb25lbnRzKCkgfD4KICBhdXRvcGxvdCgpCmBgYAoKYGBge3J9CmZpdF9wcm9waGV0ID0gZGF0YSAlPiUgbW9kZWwocHJvcGhldCh5IH4gc2Vhc29uKHBlcmlvZCA9ICJkYXkiLCBvcmRlciA9IDUpICsgI2ZvdXJpZXIoc2Vhc29uID0gNSwgSyA9IDUpCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBzZWFzb24ocGVyaW9kID0gIndlZWsiLCBvcmRlciA9IDIpICsKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHNlYXNvbihwZXJpb2QgPSAieWVhciIsIG9yZGVyID0gMikpKQpgYGAKCmBgYHtyfQpmYyA8LSBmaXRfcHJvcGhldCAlPiUgZm9yZWNhc3QoaCA9IDI1KQpmYyAlPiUgYXV0b3Bsb3QoZGF0YSkKYGBgCgpgYGB7cn0KZml0X3Byb3BoZXQgfD4KICBjb21wb25lbnRzKCkgfD4KICBhdXRvcGxvdCgpCmBgYAoKYGBge3J9Cj9wcm9waGV0CmBgYAoKYGBge3J9CmluZGV4ID0gdHFfaW5kZXgoIlNQNTAwIikgJT4lIHNlbGVjdChzeW1ib2wsIHdlaWdodCkKaW5kZXggPSBpbmRleCAlPiUgZmlsdGVyKHN5bWJvbCAhPSAiLSIpCmluZGV4CnN1bShpbmRleCR3ZWlnaHQpCmBgYAoKYGBge3J9CmRhdGEgPSB0cV9nZXQoaW5kZXgkc3ltYm9sLCBnZXQgPSAic3RvY2sucHJpY2VzIiwgZnJvbSA9ICIyMDI0LTAxLTAxIiwgdG8gPSAiMjAyNC0wMy0yOSIpICU+JSBzZWxlY3Qoc3ltYm9sLCBkYXRlLCBhZGp1c3RlZCkKYGBgCg==